home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / SUBS1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-17  |  18KB  |  782 lines

  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
  2.  
  3. unit subs1;
  4.  
  5. interface
  6.  
  7. uses crt,dos,printer,
  8.      gensubs,gentypes,statret,configrt,modem;
  9.  
  10. const is_reged:boolean = false;
  11. var firstvariable,CurrentConference,HackAttempts:byte;
  12.  
  13.     local,online,chatmode,disconnected:boolean;
  14.     conpostsa,congfilesa:longint;
  15.     unum,ulvl : integer;
  16.     baudrate,connectbaud:word;
  17.     unam,baudstr:mstr;
  18.     parity:boolean;
  19.     urec:userrec;
  20.     logontime,logofftime,logonunum:integer;
  21.     laston:longint;
  22.     dots,nochain,break,xpressed,mens,
  23.     requestchat,requestcom,requestbreak,reqspecial,forcehangup,
  24.     modeminlock,modemoutlock,timelock,tempsysop,splitmode,
  25.     fromdoor,printerecho,uselinefeeds,usecapsonly,
  26.     dontstop,nobreak,wordwrap,beginwithspacesok,sysnext,ingetstr:boolean;
  27.     regularlevel,numusers,curboardnum,lasty,
  28.     linecount,curattrib,
  29.     firstfree,lockedtime,iocode,buflen:integer;
  30.     screenseg:word;
  31.     cursection:configtype;
  32.     curboardname:sstr;
  33.     input,chainstr:anystr;
  34.     chatreason,lastprompt,errorparam,errorproc:lstr;
  35.     curboard:boardrec;
  36.     mes:message;
  37.     syslogdat:array [0..maxsyslogdat] of syslogdatrec;
  38.     numsyslogdat:integer;
  39.     returnto:char;
  40.     texttrap:Boolean;
  41.     confpromp1:string[255];
  42.     confpromp2:string[255];
  43.     confpromp3:string[255];
  44.     okfortitle:Boolean;
  45.     who_was_last:mstr;
  46.     usebottom:boolean;
  47.     lastvariable:byte;
  48.     aa,bb,cc,dd,ff:string;
  49.     usr,direct,directin:text;
  50.  
  51. const numsysfiles=20;
  52.       blanks = '                                                                         ';
  53. var tfile:file of buffer;
  54.     mapfile:file of integer;
  55.     ufile:file of userrec;
  56.     uhfile:file of mstr;
  57.     mfile:file of mailrec;
  58.     udfile:file of udrec;
  59.     afile:file of arearec;
  60.     bfile:file of bulrec;
  61.     bdfile:file of boardrec;
  62.     bifile:file of sstr;
  63.    { ffile:file of filerec;}
  64.     tofile:file of topicrec;
  65.     chfile:file of choicerec;
  66.     ddfile:file of baserec;
  67.     efile:file of entryrec;
  68.     dofile:file of doorrec;
  69.     gfile:file of grouprec;
  70.     logfile:file of logrec;
  71.     abfile:file of abrec;
  72.     usfile:file of userspecsrec;
  73.     sysfiles:array [1..numsysfiles] of file absolute tfile;
  74.     ttfile:text;
  75.  
  76. procedure dohackshit;
  77. procedure writelog (m,s:integer; prm:lstr);
  78. procedure files30;
  79. function ioerrorstr (num:integer):lstr;
  80. procedure error (errorstr,proc,param:lstr);
  81. procedure fileerror (procname,filename:mstr);
  82. procedure che;
  83. function timeleft:integer;
  84. function timetillevent:integer;
  85. procedure settimeleft (tl:integer);
  86. procedure tab (n:anystr; np:integer);
  87. function yes:boolean;
  88. function yesno (b:boolean):sstr;
  89. function timeontoday:integer;
  90. function isopen (var ff):boolean;
  91. procedure textclose (var f:text);
  92. procedure close (var ff);
  93. function withintime (t1,t2:sstr):boolean;
  94. function hungupon:boolean;
  95. function sysopisavail:boolean;
  96. function sysopavailstr:sstr;
  97. function singularplural (n:integer; m1,m2:mstr):mstr;
  98. function s (n:integer):sstr;
  99. function numthings (n:integer; m1,m2:mstr):lstr;
  100. procedure thereisare (n:integer);
  101. procedure thereare (n:integer; m1,m2:mstr);
  102. procedure assignbdfile;
  103. procedure openbdfile;
  104. procedure formatbdfile;
  105. procedure closebdfile;
  106. procedure opentempbdfile;
  107. procedure closetempbdfile;
  108. function keyhit:boolean;
  109. function bioskey:char;
  110. procedure readline (var xx);
  111. procedure writereturnbat;
  112. procedure ensureclosed;
  113. procedure clearbreak;
  114. procedure ansicolor (attrib:integer);
  115. procedure ansireset;
  116. function timetillnet:integer;
  117. procedure specialmsg (q:anystr);
  118. procedure writedataarea;
  119. procedure readdataarea;
  120. procedure blowup(a,b,c,d:integer);
  121. {procedure clearscr;}
  122. procedure printxy(a,b:integer; c:lstr);
  123. procedure fuckup(a,b,c,d:integer);
  124. procedure fuckxy(a,b:integer; m:string);
  125. procedure printzy(a,b:integer; c:lstr);
  126. procedure boxit(a,b,c,d:integer);
  127. procedure WVT52(t:anystr);
  128.  
  129. implementation
  130.  
  131. procedure boxit(a,b,c,d:integer);
  132. var cnt,tmp:integer;
  133. begin
  134.  if not (break or xpressed) then write(direct,#27,'[',a,';',b,'H');
  135.  write('╒');
  136.   for cnt:=1 to c-2 do write('═');
  137.  write('╕');
  138.  for tmp:=1 to d-2 do begin
  139.        if not (break or xpressed) then write(direct,#27,'[',A+tmp,';',b,'H');
  140.         write('│');
  141.        if not (break or xpressed) then write(direct,#27,'[',A+tmp,';',b+c-1,'H');
  142.         write('│');
  143.      end;
  144.     if not (break or xpressed) then write(direct,#27,'[',a+d-1,';',b,'H');
  145.     write('╘');
  146.     for cnt:=1 to c-2 do write('═');
  147.     write('╛');
  148.     mens:=false;
  149.  end;
  150.  
  151. procedure gotoxyand(a,b:integer; m:string);
  152. begin
  153.  if ansigraphics in urec.config then begin
  154.      write(direct,#27,'[',a,';',b,'H');
  155.      write(m);
  156.  end else writeln(m);
  157. end;
  158.  
  159. procedure fuckxy(a,b:integer; m:string);
  160. Begin
  161.   mens:=true;
  162.   nobreak:=false;
  163.     dontstop:=true;
  164.     if not (break or xpressed) then
  165.      gotoxyand(a,b,m);
  166.      mens:=false;
  167. end;
  168.  
  169.  
  170. procedure fuckup(a,b,c,d:integer);
  171. var cnt,tmp:integer;
  172. begin
  173.  mens:=true;
  174.  nobreak:=false;
  175.  dontstop:=true;
  176.  if not (ansigraphics in urec.config) then exit;
  177.  ansicolor(urec.menuboard);
  178.  boxit(a,b,c,d);
  179.  ansicolor(urec.regularcolor);
  180.  writeln;
  181.  mens:=false;
  182.  end;
  183.  
  184. procedure printxy(a,b:integer; c:lstr);
  185. Begin
  186.    clearbreak;
  187.    mens:=true;
  188.    nobreak:=true;
  189.    dontstop:=true;
  190.      if ansigraphics in urec.config then ansicolor(urec.blowinside);
  191.      gotoxyand(a,b,c);
  192.      mens:=false;
  193. end;
  194.  
  195. procedure printzy(a,b:integer; c:lstr);
  196. begin
  197.    clearbreak;
  198.    mens:=true;
  199.    nobreak:=true;
  200.    dontstop:=true;
  201.      if ansigraphics in urec.config then ansicolor(urec.statcolor);
  202.      gotoxyand(a,b,c);
  203.      mens:=false;
  204. end;
  205.  
  206.  
  207. procedure blowup(a,b,c,d:integer);
  208. var cnt,tmp:integer;
  209. begin
  210.  clearbreak;
  211.  mens:=true;
  212.  nobreak:=true;
  213.  dontstop:=true;
  214.  if ansigraphics in urec.config then ansicolor(urec.blowboard) else exit;
  215.  boxit(a,b,c,d);
  216.      mens:=false;
  217.  end;
  218.  
  219. procedure writelog (m,s:integer; prm:lstr);
  220. var n:integer;
  221.     l:logrec;
  222.     Q:Lstr;
  223.  
  224.  function lookupsyslogdat (m,s:integer):integer;
  225.   var cnt:integer;
  226.   begin
  227.     for cnt:=1 to numsyslogdat do with syslogdat[cnt] do
  228.       if (menu=m) and (subcommand=s) then begin
  229.         lookupsyslogdat:=cnt;
  230.         exit
  231.       end;
  232.     lookupsyslogdat:=0
  233.   end;
  234.  
  235. begin
  236.   with l do begin
  237.     menu:=m;
  238.     subcommand:=s;
  239.     when:=now;
  240.     param:=copy(prm,1,41)
  241.   end;
  242.   seek (logfile,filesize(logfile));
  243.   write (logfile,l);
  244.   If ConfigSet.UsePrinterLog then Begin
  245.     q:=syslogdat[lookupsyslogdat(l.menu,l.subcommand)].text;
  246.     n:=pos('%',q);
  247.     if n<>0 then q:=copy(q,1,n-1)+l.param+copy(q,n+1,255);
  248.     q:=q+' on '+DateStr(Now)+' - '+TimeStr(now);
  249.     WriteLn(Lst,Q);
  250.   End;
  251. end;
  252.  
  253. procedure files30;
  254. begin
  255.   writeln (usr,'You MUST put FILES=30 in your CONFIG.SYS!');
  256.   closeport;
  257.   halt(4)
  258. end;
  259.  
  260. function ioerrorstr (num:integer):lstr;
  261. var tf:text;
  262.     tmp1,tmp2:lstr;
  263.     n,s:integer;
  264. begin
  265.   if num=243 then files30;
  266.   assign (tf,'Ioerror.lst');
  267.   reset (tf);
  268.   if ioresult<>0 then begin
  269.     ioerrorstr:='* Can''t open IOERROR.LST *';
  270.     textclose(tf);
  271.     exit
  272.   end;
  273.   while not eof(tf) do begin
  274.     readln (tf,tmp1);
  275.     val (tmp1,n,s);
  276.     if n=num then begin
  277.       readln (tf,tmp2);
  278.       ioerrorstr:=tmp2;
  279.      textclose (tf);
  280.       exit
  281.     end
  282.   end;
  283.   textclose (tf);
  284.   ioerrorstr:='Unidentified I/O error '+strr(num)
  285. end;
  286.  
  287. procedure error (errorstr,proc,param:lstr);
  288. var p,n:integer;
  289.     pk:char;
  290.     tf:text;
  291. begin
  292.   n:=ioresult;
  293.   repeat
  294.     p:=pos('%',errorstr);
  295.     if p<>0 then begin
  296.       pk:=errorstr[p+1];
  297.       delete (errorstr,p,2);
  298.       case upcase(pk) of
  299.         '1':insert (param,errorstr,p);
  300.         'P':insert (proc,errorstr,p);
  301.         'I':insert (ioerrorstr(iocode),errorstr,p)
  302.       end
  303.     end
  304.     until p=0;
  305.     assign (tf,'ErrLog');
  306.     append (tf);
  307.     if ioresult<>0
  308.         then
  309.             begin
  310.              textclose (tf);
  311.                 rewrite (tf);
  312.                 writeln (tf,'                        ViSiON v1.0 Error Log                   ',datestr(now),' ',timestr(now));
  313.                 writeln (tf,'─────────────────────────────────────────────────────────────────────────────-');
  314.                 writeln (tf);
  315.             end;
  316.     if unam='' then
  317.     writeln (tf,'Someone was logging in on ',datestr(now), ' at ',timestr(now),' when:')
  318.     else
  319.     writeln (tf,unam,' was on-line on ',datestr(now),' at ',timestr(now),' when:');
  320.     writeln (tf,errorstr);
  321.     writeln (tf);
  322.     textclose (tf);
  323.     n:=ioresult;
  324.     writelog (0,4,errorstr);
  325.     writeln (errorstr);
  326.     textclose(tf);
  327. end;
  328.  
  329. procedure fileerror (procname,filename:mstr);
  330. begin
  331.   error ('%I accessing %1 in %P',procname,filename)
  332. end;
  333.  
  334. procedure che;
  335. var i:integer;
  336. begin
  337.   i:=ioresult;
  338.   case i of
  339.     0:;
  340.     4:files30;
  341.     else
  342.       begin
  343.         iocode:=i;
  344.         error ('Unexpected I/O error %I','','')
  345.       end
  346.   end
  347. end;
  348.  
  349. function timeleft:integer;
  350. var timeon:integer;
  351. begin
  352.   timeon:=timer-logontime;
  353.   if timeon<0 then timeon:=timeon+1440;
  354.   timeleft:=urec.timetoday-timeon
  355. end;
  356.  
  357. function timetillevent:integer;
  358. var n:integer;
  359. begin
  360.   if (length(configset.eventtim)=0) or (length(configset.eventbatc)=0) or
  361.     (timedeventdate=datestr(now))
  362.     then n:=1440
  363.     else n:=timeval(configset.eventtim)-timer;
  364.   if n<0 then n:=n+1440;
  365.   timetillevent:=n
  366. end;
  367.  
  368. function timetillnet:integer;
  369. var n:integer;
  370.   begin
  371.   if ((length(configset.netstc)=0) and (length(Configset.NetStart)=0))
  372.     or
  373.     (neteventdate=datestr(now)) then n:=1440
  374.     else
  375.       If Length(Configset.NetStc)>0 then n:=timeval(configset.netstc)-timer
  376.       Else n:=TimeVal(Configset.NetStart)-timer;
  377.   if n<0 then n:=n+1440;
  378.   timetillnet:=n;
  379. end;
  380.  
  381. procedure settimeleft (tl:integer);
  382. begin
  383.   urec.timetoday:=timer+tl-logontime;
  384. end;
  385.  
  386. procedure tab (n:anystr; np:integer);
  387. var cnt:integer;
  388. begin
  389.   write (n);
  390.   for cnt:=length(n) to np-1 do write (' ')
  391. end;
  392.  
  393. function yes:boolean;
  394. begin
  395.   if length(input)=0
  396.     then yes:=false
  397.     else yes:=upcase(input[1])='Y'
  398. end;
  399.  
  400. function yesno (b:boolean):sstr;
  401. begin
  402.   if b
  403.     then yesno:='Yes'
  404.     else yesno:='No'
  405. end;
  406.  
  407. function timeontoday:integer;
  408. var timeon:integer;
  409. begin
  410.   timeon:=timer-logontime;
  411.   if timeon<0 then timeon:=timeon+1440;
  412.   timeontoday:=timeon
  413. end;
  414.  
  415. function isopen (var ff):boolean;
  416. var fi:fib absolute ff;
  417. begin
  418.   isopen:=fi.handle<>0
  419. end;
  420.  
  421. procedure textclose (var f:text);
  422. var n:integer;
  423.     fi:fib absolute f;
  424. begin
  425.   if isopen(f)
  426.     then system.close (f);
  427.   fi.handle:=0;
  428.   n:=ioresult
  429. end;
  430.  
  431. procedure close (var ff);
  432. var f:file absolute ff;
  433.     fi:fib absolute ff;
  434.     n:integer;
  435. begin
  436.   if isopen(f)
  437.     then system.close (f);
  438.   fi.handle:=0;
  439.   n:=ioresult
  440. end;
  441.  
  442. function withintime (t1,t2:sstr):boolean;
  443. var t,a,u:integer;
  444. begin
  445.   t:=timeval(timestr(now));
  446.   a:=timeval(t1);
  447.   u:=timeval(t2);
  448.   if a<=u
  449.     then withintime:=(t>=a) and (t<=u)
  450.     else withintime:=(t>=a) or (t<=u);
  451. end;
  452.  
  453. function hungupon:boolean;
  454. begin
  455.   hungupon:=forcehangup or
  456.   (online and not (carrier or modeminlock or modemoutlock))
  457. end;
  458.  
  459. function sysopisavail:boolean;
  460. begin
  461.   case sysopavail of
  462.     available:sysopisavail:=true;
  463.     notavailable:sysopisavail:=false;
  464.     bytime:sysopisavail:=withintime (configset.availtim,configset.unavailtim)
  465.   end
  466. end;
  467.  
  468. function sysopavailstr:sstr;
  469. const strs:array [available..notavailable] of string[9]=
  470.         ('Yes','By time: ','No');
  471. var tstr:sstr;
  472.     tmp:availtype;
  473. begin
  474.   tstr:=strs[sysopavail];
  475.   if sysopavail=bytime
  476.     then
  477.       begin
  478.         if sysopisavail
  479.           then tmp:=available
  480.           else tmp:=notavailable;
  481.         tstr:=tstr+strs[tmp]
  482.       end;
  483.   sysopavailstr:=tstr
  484. end;
  485.  
  486. function singularplural (n:integer; m1,m2:mstr):mstr;
  487. begin
  488.   if n=1
  489.     then singularplural:=m1
  490.     else singularplural:=m2
  491. end;
  492.  
  493. function s (n:integer):sstr;
  494. begin
  495.   s:=singularplural (n,'','s')
  496. end;
  497.  
  498. function numthings (n:integer; m1,m2:mstr):lstr;
  499. begin
  500.   numthings:=strr(n)+' '+singularplural (n,m1,m2)
  501. end;
  502.  
  503. procedure thereisare (n:integer);
  504. begin
  505.   write ('There ');
  506.   if n=1
  507.     then write ('is 1 ')
  508.     else
  509.       begin
  510.         write ('are ');
  511.         if n=0
  512.           then write ('no ')
  513.           else write (n,' ')
  514.        end
  515. end;
  516.  
  517. procedure thereare (n:integer; m1,m2:mstr);
  518. begin
  519.   thereisare (n);
  520.   if n=1
  521.     then write (m1)
  522.     else write (m2);
  523.   writeln ('.')
  524. end;
  525.  
  526. procedure assignbdfile;
  527. begin
  528.   If CurrentConference=1 then Begin
  529.   assign (bdfile,configset.boarddi+'boarddir');
  530.   assign (bifile,configset.boarddi+'bdindex');
  531.   End Else Begin
  532.   Assign(Bdfile,ConfigSet.BoardDi+'Boarddir.'+Strr(CurrentConference));
  533.   Assign(BiFile,ConfigSet.BoardDi+'BdIndex.'+Strr(CurrentConference));
  534.   end;
  535. end;
  536.  
  537. procedure openbdfile;
  538. var i:integer;
  539. begin
  540.   closebdfile;
  541.   assignbdfile;
  542.   reset (bdfile);
  543.   i:=ioresult;
  544.   reset (bifile);
  545.   i:=i or ioresult;
  546.   if i<>0 then formatbdfile
  547. end;
  548.  
  549. procedure formatbdfile;
  550. begin
  551.   close (bdfile);
  552.   close (bifile);
  553.   assignbdfile;
  554.   rewrite (bdfile);
  555.   rewrite (bifile)
  556. end;
  557.  
  558. procedure closebdfile;
  559. begin
  560.   close (bdfile);
  561.   close (bifile)
  562. end;
  563.  
  564. var wasopen:boolean;
  565.  
  566. procedure opentempbdfile;
  567. begin
  568.   wasopen:=isopen(bdfile);
  569.   if not wasopen then openbdfile
  570. end;
  571.  
  572. procedure closetempbdfile;
  573. begin
  574.   if not wasopen then closebdfile
  575. end;
  576.  
  577. function keyhit:boolean;
  578. (*var r:registers;
  579. begin
  580.   r.ah:=1;
  581.   intr ($16,r);
  582.   keyhit:=(r.flags and 64)=0
  583. end;*)
  584. begin
  585.  KeyHit:=KeyPressed;
  586. End;
  587.  
  588. function bioskey:char;
  589. var r:registers;
  590. begin
  591.   r.ah:=0;
  592.   intr ($16,r);
  593.   if r.al=0
  594.     then bioskey:=chr(r.ah+128)
  595.     else bioskey:=chr(r.al)
  596. end;
  597.  
  598. procedure readline (var xx);
  599. var a:anystr absolute xx;
  600.     l:byte absolute xx;
  601.     k:char;
  602.  
  603.   procedure backspace;
  604.   begin
  605.     if l>0 then begin
  606.       write (usr,^H,' ',^H);
  607.       l:=l-1
  608.     end
  609.   end;
  610.  
  611.   procedure eraseall;
  612.   begin
  613.     while l>0 do backspace
  614.   end;
  615.  
  616.   procedure addchar (k:char);
  617.   begin
  618.     if l<buflen then begin
  619.       l:=l+1;
  620.       a[l]:=k;
  621.       write (usr,k)
  622.     end
  623.   end;
  624.  
  625. begin
  626.   l:=0;
  627.   repeat
  628.     k:=bioskey;
  629.     case k of
  630.       #8:backspace;
  631.       #27:eraseall;
  632.       #32..#126:addchar(k)
  633.     end
  634.   until k=#13;
  635.   writeln (usr)
  636. end;
  637.  
  638. procedure writereturnbat;
  639. var tf:text;
  640.     bd:word;
  641.     tmp:lstr;
  642. begin
  643.   assign (tf,'return.bat');
  644.   rewrite (tf);
  645.   getdir (0,tmp);
  646.   writeln (tf,'cd '+tmp);
  647.   if unum=0
  648.     then begin
  649.       writeln (tf,'PAUSE   ***  No one was logged in!');
  650.       writeln (tf,'run');
  651.     end else begin
  652.       if online then bd:=baudrate else bd:=0;
  653.       bd:=connectbaud;
  654.       if not carrier then bd:=0;
  655.       writeln (tf,'run ',unum,' ',bd,' ',ord(parity),' M')
  656.     end;
  657.   textclose (tf);
  658.   writeln (usr,'  ( Type RETURN To Return To VISION!');
  659. end;
  660.  
  661. procedure ensureclosed;
  662. var cnt,i:integer;
  663. begin
  664.   stoptimer (numminsidle);
  665.   stoptimer (numminsused);
  666.   writestatus;
  667.   textclose (ttfile);
  668.   i:=ioresult;
  669.   for cnt:=1 to numsysfiles do begin
  670.     close (sysfiles[cnt]);
  671.     i:=ioresult
  672.   end
  673. end;
  674.  
  675. procedure clearbreak;
  676. begin
  677.   break:=false;
  678.   xpressed:=false;
  679.   dontstop:=false;
  680.   nobreak:=false
  681. end;
  682.  
  683. procedure ansicolor (attrib:integer);
  684. var tc:integer;
  685.     m:mstr;
  686. const colorid:array [0..7] of byte=(30,34,32,36,31,35,33,37);
  687. begin
  688.   if attrib=0 then begin
  689.     textcolor (7);
  690.     textbackground (0)
  691.   end else begin
  692.     textcolor (attrib and $8f);
  693.     textbackground ((attrib shr 4) and 7)
  694.   end;
  695.   if not (ansigraphics in urec.config) or (attrib=0) or (usecapsonly)
  696.      or (attrib=curattrib) or break then exit;
  697.   curattrib:=attrib;
  698.   m:=#27+'[0';
  699.   tc:=attrib and 7;
  700.   if tc<>7 then m:=m+';'+strr(colorid[tc]);
  701.   tc:=(attrib shr 4) and 7;
  702.   if tc<>0 then m:=m+';'+strr(colorid[tc]+10);
  703.   if (attrib and 8)=8 then m:=m+';1';
  704.   if (attrib and 128)=128 then m:=m+';5';
  705.   m:=m+'m';
  706.   write (direct,m)
  707. end;
  708.  
  709. procedure ansireset;
  710. begin
  711.   textcolor (7);
  712.   textbackground (0);
  713.   if usecapsonly then exit;
  714.   if urec.regularcolor<>0 then begin
  715.     ansicolor (urec.regularcolor);
  716.     exit
  717.   end;
  718.   if (not (ansigraphics in urec.config)) or (curattrib=0) or break then exit;
  719.   write (direct,#27'[0m');
  720.   curattrib:=0
  721. end;
  722.  
  723. procedure specialmsg (q:anystr);
  724. begin
  725.   textcolor (configset.outlockcolo);
  726.   textbackground (0);
  727.   writeln (usr,q);
  728.   if not modemoutlock then textcolor (configset.normbotcolo)
  729. end;
  730.  
  731. procedure readdataarea;
  732. var f:file of byte;
  733. begin
  734.   assign (f,'General.dat');
  735.   reset (f);
  736.   if ioresult<>0
  737.     then unum:=-1
  738.     else begin
  739.       dos.filerec(f).recsize:=ofs(lastvariable)-ofs(firstvariable);
  740.       read (f,firstvariable);
  741.       close (f)
  742.     end
  743. end;
  744.  
  745. procedure writedataarea;
  746. var f:file of byte;
  747. begin
  748.   assign (f,'General.dat');
  749.   rewrite (f);
  750.   dos.filerec(f).recsize:=ofs(lastvariable)-ofs(firstvariable);
  751.   write (f,firstvariable);
  752.   close (f)
  753. end;
  754.  
  755. procedure WVT52(t:anystr);
  756.   var cnt:integer;
  757.   begin
  758.   if modemoutlock then exit;
  759.    if t[2]=#234 then delete (t,1,1);
  760.    for cnt:=1 to length(t) do sendchar (t[cnt]);
  761.   end;
  762.  
  763. procedure dohackshit;
  764. Begin
  765.     WriteLog(22,HackAttempts,Urec.Handle);
  766.     Case HackAttempts of
  767.          2:WriteLn(^M^S^G'Don''t even try it!');
  768.          3:WriteLn(^M^S^G'Do that again, and your history..');
  769.          4:Begin
  770.                 WriteLn(^M^S^G'We warned you!');
  771.                 SetTimeLeft(-1);
  772.                 Delay(500);
  773.                 ForceHangup:=True;
  774.                 HangUp;
  775.                 End;
  776.          End;
  777.     End;
  778.  
  779. begin
  780. HackAttempts:=0;
  781. end.
  782.